home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / Ant Movie Catalog 3.5.0.2 / amc_install.exe / {app} / Scripts / MrCinemaCinefilCommon.pas < prev    next >
Pascal/Delphi Source File  |  2005-04-07  |  17KB  |  393 lines
  1. unit MrCinemaCinefilCommon;
  2. (***************************************************
  3. partie commune aux scripts MrCinema et Cinefil
  4. nΘcessite les modules StringUtils7552.pas et StringUtils1.pas
  5. version 1.1
  6. ***************************************************)
  7.  
  8. uses
  9.    StringUtils7552;
  10.  
  11. const
  12.    cinefil_id = 0;                                                // identifiants
  13.    mrcinema_id = 1;
  14. //
  15.    CinefilBase = 'http://www.cinefil.com';
  16.    CinefilUrl  = CinefilBase + '/cinefil2005/';
  17. { recherche: les films sont triΘs par annΘe (dΘcroissante)}
  18.    CinefilUrlLook = CinefilUrl + 'CFM_Recherches/films.cfm?lachaine2=';
  19.    
  20. var
  21. // note FormatUTF8 est dΘclarΘ dans StringUtils7552 (integer)
  22.    filmok, debug: Boolean;
  23.     MovieName, firstcall, abort, batchlogfic, debugrep, msgano: string;
  24.    batchlog, confbatch: TstringList;
  25.    calledBy, BatchMode, FormatTitre: integer;
  26.    bestpoids, maxcount, pagemax: Integer;
  27.    PageNext, PagePrev, bestadr, besttxt, lookreal, lookmovie, looktxt: String;
  28.  
  29. //------------------------------------------------------------------------------
  30. // recherche du film (cinΘfil)
  31. // MovieName = nom du film cherchΘ (tel que saisi, cad non formatΘ)
  32. //------------------------------------------------------------------------------
  33. procedure AnalyzePageCinefil;
  34. var
  35.    Address, Page, Line, Value, PageFilm, urlfilm: string;
  36.    pagenum, i: integer;
  37.    memo: TStringList;
  38.  
  39. begin
  40.    pagenum := 0;                                             // compteur de pages
  41. // init adresse 1Φre recherche    
  42.    Address := CinefilUrlLook+FormatMovieName3(MovieName);
  43.    repeat
  44. // traitement page courante
  45.    PageNext := '';
  46.    PagePrev := '';
  47.    pagenum := pagenum + 1;
  48.    FormatUTF8 := 0;
  49.    memoAdr := TStringList.Create;                           // init liste de mΘmo
  50.    memoTxt := TStringList.Create;
  51.    Page := GetPage(UrlEncode(Address));
  52.    if debug then
  53.       DumpPage(debugrep+'choixCinefil'+IntToStr(pagenum)+'.txt', Page);    // debug
  54.    Page := TextAfter(Page, '<B> RΘsultat ');     // infos utiles
  55.    if Page = '' then
  56.    begin
  57.       LogMessage('CinΘfil: erreur lecture page de recherche '+IntToStr(pagenum)); // non trouvΘ = erreur
  58.       memoAdr.Free;
  59.       memoTxt.Free;
  60.       exit;
  61.    end;
  62. // recherche pages prΘcΘdente et suivante
  63.    Line := TextBefore(Page, '</TD>', '');            // Line = url's << < page1 page2 ... > >>
  64.    Page := RemainingText;
  65.    if Pos('HREF', AnsiUpperCase(Line)) = 0 then Line := '';           // 1 seule page
  66.    while Line <> '' do
  67.    begin   
  68.       Value := TextBefore(Line, '/a>', '');            // Value = url page xxx
  69.       Delete(Line, 1, Pos('</a>', Line)+4);            // Line = les suivantes
  70. // ignorer les "retours rapides" (<< et >>) pour ne pas confondre avec < et >
  71.       if Pos('><<<', Value) > 0 then continue;
  72.       if Pos('>>><', Value) > 0 then continue;
  73.       if Pos('><<', Value) > 0 then           
  74.       begin                                           // Value = url page prΘcΘdente
  75.          PagePrev := GetUrl(Value, '', CinefilBase);
  76.          memoAdr.Add(PagePrev);
  77.          memoTxt.Add('<<< page prΘcΘdente');
  78.       end;
  79.       if Pos('>><', Value) > 0 then
  80.          PageNext := GetUrl(Value, '', CinefilBase);   // Value = url page suivante
  81.    end;  {while line <> ''}                                       
  82. // mΘmo des films de cette page
  83.    urlfilm := 'HREF=''../fichefilm.cfm?ref=';
  84.    memo := TStringList.Create;
  85.    memo.Text := StringReplace(Page, '</TR>', crlf);  // separe lignes
  86.    for i := 0 to memo.Count-1 do           
  87.    begin
  88.    Line := memo.GetString(i);   
  89.    PageFilm := GetUrl(Line, urlfilm, CinefilUrl);
  90.    if PageFilm = '' then continue;     // pas d'url = autre chose ou ligne vide
  91.    memoAdr.Add(PageFilm);
  92. // sΘparer le rΘalisateur du reste avant HTMLRemoveTags
  93.    Line := StringReplace(Line, '</a>', sepchar1);  // aprΦs le titre
  94.    memoTxt.Add(FormatText(Line));  // [annΘe] nom du film sepchar1 de rΘalisateur
  95.    end;         {for i}
  96.    memo.Free;
  97.    if PageNext <> '' then           
  98.    begin                                       
  99.       memoAdr.Add(PageNext);
  100.       memoTxt.Add('>>> page suivante');
  101.    end;
  102.    if memoAdr.Count = 0 then
  103.    begin
  104.       LogMessage('CinΘfil: aucun film trouvΘ pour "'+MovieName+'"');
  105.       memoAdr.Free;
  106.       memoTxt.Free;
  107.       exit;
  108.    end;
  109.    if BatchMode > 0 then
  110.    begin                         
  111. // mode batch : recherche du meilleur poids pour les films de cette page                     
  112.       LookBest(cinefil_id);
  113.       if (bestpoids = maxcount) or (PageNext = '') or (pagenum > pagemax) then
  114. // poids max ou pas de page next ou max pages lues: on arrΩte
  115.       begin     
  116.          if bestpoids > 0 then                  // on a trouvΘ quelque chose
  117.          begin                       
  118.             if bestpoids < maxcount then               // infos partielles
  119.                   LogMessage('CinΘfil: '+looktxt+' retenu '+besttxt+' (poids='+IntToStr(bestpoids)+')');
  120.             AnalyzePageFilmCinefil(bestadr);                            // page film
  121.          end else
  122.             LogMessage('CinΘfil: pas de correspondance pour '+looktxt);
  123.          break;               // on sort
  124.       end else
  125. // sinon, on va chercher s'il y a mieux dans pagenext
  126.       Address := PageNext;             
  127.    end else
  128.    begin                                         
  129. // mode normal
  130.       Address := SelectMovie('Films (CinΘfil)');
  131.       if Address <> '' then
  132.       begin
  133.          if (Address <> PageNext) and (Address <> PagePrev) then
  134.          begin
  135.             AnalyzePageFilmCinefil(Address);                          // page film
  136.             break;                                                    // on sort
  137.          end;   
  138.       end else
  139.          LogMessage('CinΘfil: aucun film sΘlectionnΘ');
  140.    end;
  141.    until (Address = '');
  142.    memoAdr.Free;
  143.    memoTxt.Free;
  144. end;
  145.  
  146. //------------------------------------------------------------------------------
  147. // analyse de la page du film (CinΘfil)
  148. //------------------------------------------------------------------------------
  149. procedure AnalyzePageFilmCinefil(Address: string);
  150. var
  151.    Page, Table, Value, Value2: string;
  152.    BeginPos: Integer;
  153.  
  154. begin
  155.    FormatUTF8 := 0;                 
  156.    Page := GetPage(Address);
  157.    if debug then
  158.       DumpPage(debugrep+'filmCinefil.txt', Page);    // debug
  159.    Page := TextAfter(Page, 'RΘfΘrence film cinefil');          // vire le dΘbut
  160.    if Page = '' then
  161.    Begin
  162.       LogMessage('CinΘfil: erreur lecture page film');
  163.       exit;
  164.    end;
  165.    filmok := True;                                         // τa y est, c'est bon
  166.    if calledBy = cinefil_id then SetField(fieldURL, Address);
  167.    if CanSetPicture then
  168.    begin 
  169. // affiche: test s'il y a un grand format
  170.       Value := TextBetween(Page, 'javascript:ZoomPhoto(''', '''');
  171.       if Value = '' then                    // sinon test s'il y a un petit format
  172.          Value := TextBetween(Page, '<IMG class=photo SRC=''', '''');     
  173.       if Value <> '' then
  174.          GetPicture(Value)
  175.       else
  176.       begin
  177.          if (calledBy <> cinefil_id) then 
  178.          begin   
  179.             Value := 'CinΘfil: pas d''affiche prΘvue pour "'+MovieName+'"';
  180.             if BatchMode > 0 then               
  181.                LogMessage(Value)
  182.             else
  183.                ShowInformation(Value);
  184.          end;
  185.       end;
  186.    end;       {CanSetPicture}
  187.    if calledBy = mrcinema_id then exit;           // MrCinΘma: affiche uniquement
  188. // pays annΘe et durΘe
  189.    Value := TextBetween(Page, '<font class="smallnoir">', '<BR>');
  190.    Page := RemainingText;
  191.    Value := StringReplace(Value, '- ', sepchar1);     // sΘpare les champs
  192.    Value := FormatText(Value);                             // supprime les tags
  193.    Value2 := Trim(TextBefore(Value, sepchar1, ''));        // pays (plusieurs possibles)
  194.    Value := RemainingText;
  195.    SetField(fieldCountry, Value2);
  196.    Value2 := Trim(TextBefore(Value, sepchar1, ''));        // annΘe
  197.    Value := RemainingText;
  198.    SetField(fieldYear, Value2);
  199.    Value2 := Trim(TextBefore(Value, sepchar1, ''));        // durΘe heuresHminutes       
  200.    BeginPos := Pos('H', AnsiUpperCase(Value2));
  201.    Value2 := IntToStr(StrToInt(Left(Value2, BeginPos-1), 0) * 60 + StrToInt(Copy(Value2, BeginPos+1, 2), 0));
  202.    SetField(fieldLength, Value2);
  203. // titre original ou traduit
  204.    Value := TextBetween(Page, '<font class="noir"><font class="rouge16"><B>', '</B>');
  205.    Page := RemainingText;
  206.    Value := FormatText(Value);
  207. // titre original Θventuel
  208.    Value2 := FormatText(TextBetween(Page, '<BR>Titre original :<font class="smallrouge"> <B>', '</B>'));
  209.    Value2 := TranslateText(Value2, FormatTitre);
  210.    Value := TranslateText(Value, FormatTitre);
  211.    if (Value2 = '') or (Value = Value2) then              // 1er titre = original
  212.    begin
  213.       SetField(fieldOriginalTitle, Value);
  214.       SetField(fieldTranslatedTitle, '');   
  215.    end else
  216.    begin                                                  // traduit + original
  217.       Page := RemainingText;
  218.       SetField(fieldOriginalTitle, Value2);
  219.       SetField(fieldTranslatedTitle, Value);
  220.    end;
  221. // catΘgorie et rΘalisateur (un/une catΘgorie de rΘalisateur)
  222.    Value := TextBetween(Page, '<font class="noir"><BR>', '<BR>');
  223.    Page := RemainingText;
  224.    Value2 := FormatText(TextAfter(Value, '<B>'));            // rΘalisateur(s)
  225.    SetField(fieldDirector, Value2);
  226.    Value := FormatText(TextBefore(Value, '<B>', ''));         // un/une catΘgorie(s)
  227.    BeginPos := Pos('UN', AnsiUpperCase(Value));                  // virer l'article
  228.    if BeginPos = 1 then
  229.    begin
  230.       BeginPos := Pos(' ', Value);
  231.       Delete(Value, 1, BeginPos);
  232.    end;
  233.    BeginPos := LastPos('DE', AnsiUpperCase(Value));            // virer 'de'
  234.    if BeginPos > 0 then
  235.       Value := Left(Value, BeginPos -1);
  236.    SetField(fieldCategory, Trim(Value));
  237. // acteurs
  238.    Value := TextBefore(Page, '<TABLE BORDER=0><TR><TD><font class=noir>', '');
  239.    Page := RemainingText;
  240.    Value := FormatText(TextBetween(Value, 'avec', crlf));
  241.    SetField(fieldActors, Value);   
  242. // description
  243.    Value := FormatText(TextBefore(Page, '</TABLE>', ''));
  244.    SetField(fieldDescription, Value);
  245. end;
  246.  
  247. //------------------------------------------------------------------------------
  248. // recherche du film correspondant α lookmovie/lookreal (mode batch)
  249. // mΘmorisation de bestpoids, bestadr et besttxt
  250. //------------------------------------------------------------------------------
  251. procedure LookBest(id: integer);
  252. var
  253.    Value, Address, realisateur, name: string;
  254.    filmnum, poids, i: integer;
  255.    
  256. begin
  257. // rechercher dans la liste mΘmorisΘe le nom du film/rΘalisateur demandΘ
  258. // attention: memoTxt. dΘjα passΘ dans FormatText donc plus de tags et en ascii
  259.    for filmnum := 0 to memoTxt.Count -1 do
  260.    begin
  261.       Address := memoAdr.GetString(filmnum);
  262.       if (Address = PageNext) or (Address = PagePrev) then continue;     // sauf page prev/next   
  263.       Value := memoTxt.GetString(filmnum);     
  264.       if id = cinefil_id then                     
  265. // fiche CinΘfil
  266.       begin                                        // [annΘe] nom du film de rΘalisateur
  267.          name := TextBetween(Value, ']', sepchar1);   // nom du film
  268.          realisateur := RemainingText;                // de rΘalisateur(s)   
  269.          realisateur := TextAfter(realisateur, 'de');
  270.       end else
  271.       begin                                       
  272. // fiche MrCinema
  273.        name := TextBefore(Value, sepchar1 , '');  // nom du film
  274.          Value := RemainingText;                    // de rΘalisateur (annΘe facultative)
  275.          realisateur := TextAfter(Value, 'de');     // attention: pas de TextBetween
  276.          Value := TextBefore(realisateur, '(', '');
  277.          if Value <> '' then realisateur := Value;       
  278.       end;
  279.       realisateur := FormatRealisateur(realisateur);  // rΘalisateur (peut Ωtre '')
  280.       name := CleanString(name);                      // nom du film
  281. // poids rΘalisateur(s)   
  282. // ignorer si poids = 0 et les 2 champs non vides
  283.       poids := CompareWords(lookreal, realisateur);
  284.       if (lookreal = '') or (realisateur = '') or (poids > 0) then
  285.       begin
  286. // + (poids du film)x1000
  287. // on refuse poids(rΘalisateur) = 0 si nom du film approximatif (poids <> 100)
  288.          i := CompareWords(lookmovie, name);
  289.          if (poids > 0) or (i = 100) then poids := poids + (i * 1000);
  290.       end;
  291.       if (poids > 1000) and (poids > bestpoids) then       // rΘsultat des courses
  292. // il faut quand mΩme qu'il y ait au moins 1 mot du titre   !!!
  293.       begin                                                  // courant = meilleur
  294.          bestpoids := poids;
  295.          bestadr := Address;
  296.          besttxt := '"'+StringReplace(memoTxt.GetString(filmnum), sepchar1, '')+'"';
  297.          if bestpoids = maxcount then break;   // exact match: inutile de continuer
  298.       end;
  299.    end;    {for filmnum}         
  300. end;
  301.  
  302. //------------------------------------------------------------------------------
  303. // initialisations pour batch mode (nom+rΘalisateur)
  304. //------------------------------------------------------------------------------
  305. procedure initBatchLook;
  306. begin
  307.    lookreal := GetField(fieldDirector);                // rΘalisateur(s) peut Ωtre ''
  308.    lookmovie := MovieName;                             // nom du film
  309.    looktxt := '"'+lookmovie+'/'+lookreal+'"';          // pour les messages
  310.    lookreal := FormatRealisateur(lookreal);            // formatages
  311.    lookmovie := CleanString(lookmovie);   
  312.    bestpoids := 0;                                     // init meilleur poids
  313.    maxcount := 100100;                                 // poids maximum
  314.    pagemax := 2;                                       // lire au maximum 3 pages
  315.    bestadr := '';                                      // mΘmo adresse page trouvΘe
  316.    besttxt := '';                                      // et nom du film/rΘalisateur
  317. end;
  318.  
  319. //------------------------------------------------------------------------------
  320. // formatage realisateur
  321. //------------------------------------------------------------------------------
  322. function FormatRealisateur(str: string) :string;
  323. begin
  324.    str := CleanString(str);         
  325. // supprimer les 'et' pour ne garder que les noms
  326. // ce serait dommage de sΘlectionner une fiche parce qu'il y a seulement 'et' en commun !
  327.    str := StringReplace(str, ' et ', ' ');
  328.    str := StringReplace(str, ' & ', ' ');
  329.    result := str;
  330. end;
  331.  
  332. //------------------------------------------------------------------------------
  333. // valorisation de msgano (mode normal) ou ajout dans la log (mode batch)
  334. //------------------------------------------------------------------------------
  335. procedure LogMessage(m: string);
  336. begin
  337.    if BatchMode > 0 then
  338.       AddToLog('fiche '+GetField(fieldNumber)+': '+m)
  339.    else
  340.       msgano := m;
  341. end;
  342.  
  343. //------------------------------------------------------------------------------
  344. // initialisation de la log
  345. //------------------------------------------------------------------------------
  346. procedure initBatchLog;
  347. begin
  348.    batchlog := TStringList.Create; 
  349.    batchlog.Add('dΘmarrage mode batch');
  350.    batchlog.Add('poids = xxxyyy avec xxx poids du nom du film et yyy poids du rΘalisateur');
  351.    batchlog.Add('chaque poids = pourcentage du nombre de mots cherchΘs/trouvΘs');
  352.    batchlog.Add('100 = correspondance exacte');
  353.    batchlog.Add(StringOfChar('*',80));
  354.    batchlog.SaveToFile(batchlogfic);
  355. // message pour confirmation
  356.    confbatch := TStringList.Create;
  357.    confbatch.Add('Vous avez sΘlectionnΘ le mode batch:');
  358.    confbatch.Add('Avez-vous sauvegardΘ votre base?');
  359.    confbatch.Add('');
  360.    confbatch.Add('En fin de traitement:');
  361.    confbatch.Add('- consultez le fichier '+batchlogfic+' pour les erreurs/infos');
  362.    confbatch.Add('- les films trouvΘs seront cochΘs, les autres non (pour la sΘlection)');
  363.    confbatch.Add(' (voir: outils/prΘfΘrences/liste des films/cases α cocher)');
  364.    confbatch.Add('');
  365.    confbatch.Add('confirmez votre choix');   
  366. end;   
  367.  
  368. //------------------------------------------------------------------------------
  369. // ajoute un message dans la log et sauvegarde sur disque
  370. // (parce que je ne sais pas quand τa finit...)
  371. //------------------------------------------------------------------------------
  372. procedure AddToLog(m: string);
  373. begin
  374.    batchlog.Add(m);
  375.    batchlog.SaveToFile(batchlogfic);
  376. end;
  377.  
  378. //------------------------------------------------------------------------------
  379. // formatage du nom du film (CinΘfil)
  380. //------------------------------------------------------------------------------
  381. function FormatMovieName3(str: string) :string;
  382. begin
  383. // une petite Θdition avant de formater           
  384.    str := StringReplace(str, ' & ', ' et ');
  385. // remplacer les apostrophes, tirets et points par des blancs       
  386.    str := StringReplace(str, '''', ' ');       
  387.    str := StringReplace(str, '.', ' ');   
  388.     str := StringReplace(str, '-', ' ');   
  389.    result := FormatMovieName(str);
  390. end;
  391.                              
  392. end.
  393.